home *** CD-ROM | disk | FTP | other *** search
/ Dr. Windows 3 / dr win3.zip / dr win3 / VISUALBA / VB_SMPL.ZIP / CDPLAY.EXE / GLOBAL.BAS < prev    next >
BASIC Source File  |  1994-03-31  |  23KB  |  763 lines
  1. Option Explicit
  2. ' Version Number
  3. Global Const MCI_APP_TITLE = "CD Player"
  4. Global Const Version = "Version 1.1"
  5.  
  6. '*** Global Constants ***
  7. Global Const Timer_Interval = 1000
  8. Global Const SecondsPerMinute = 60
  9. Global Const SecondsPerHour = SecondsPerMinute * 60
  10. Global Const SecondsPerDay = SecondsPerHour * 24&
  11.  
  12. '*** Global Variables ***
  13. Global TrackNumChange As Integer
  14. Global CRLF As String
  15. Global Tracks_Loaded As Integer
  16. Global NumOfTracks As Integer
  17. Global TrackIndex As Integer
  18. Global AppPath As String
  19. Global MouseX As Integer
  20. Global MouseY As Integer
  21.  
  22. '*** CD Information ***
  23. Type CD
  24.     CDTitle As String
  25.     ID As Long
  26.     CDAuthor As String
  27.     CDTotalTime As Variant
  28.     CDTrack As Integer
  29. End Type
  30. Global CDTrackNo() As String
  31. Global CDTime() As Variant
  32. Global CDInfo As CD
  33.  
  34. ' These constants are defined in mmsystem.h.
  35. Global Const MCIERR_INVALID_DEVICE_ID = 30257
  36. Global Const MCIERR_DEVICE_OPEN = 30263
  37. Global Const MCIERR_CANNOT_LOAD_DRIVER = 30266
  38. Global Const MCIERR_UNSUPPORTED_FUNCTION = 30274
  39. Global Const MCIERR_INVALID_FILE = 30304
  40. Global Const MCI_NOTIFY_SUCCESSFUL = 1
  41.  
  42. Global Const MCI_MODE_NOT_OPEN = 524
  43. Global Const MCI_MODE_STOP = 525
  44. Global Const MCI_MODE_PLAY = 526
  45. Global Const MCI_MODE_RECORD = 527
  46. Global Const MCI_MODE_SEEK = 528
  47. Global Const MCI_MODE_PAUSE = 529
  48. Global Const MCI_MODE_READY = 530
  49.  
  50. ' Track Information Format
  51. Global Const MCI_FORMAT_MILLISECONDS = 0
  52. Global Const MCI_FORMAT_TMSF = 10
  53.  
  54. ' For Tab Stops in ListBox
  55. Declare Function SendMessage Lib "user" (ByVal hWnd As Integer, ByVal wMsg As Integer, ByVal wp As Integer, lp As Any) As Long
  56. Global Const WM_USER = &H400
  57. Global Const LB_SETTABSTOPS = WM_USER + 19
  58.  
  59. ' SetWindowPOSITION
  60. Declare Function SetWindowPos Lib "User" (ByVal h1%, ByVal h2%, ByVal X%, ByVal Y%, ByVal cx%, ByVal cy%, ByVal f%) As Integer
  61. Global Const HWND_TOPMOST = -1
  62. Global Const HWND_NOTOPMOST = -2
  63. Global Const SWP_NOMOVE = 2
  64. Global Const SWP_NOSIZE = 1
  65. Global Const FLAGS = SWP_NOMOVE Or SWP_NOSIZE
  66.  
  67. ' For creation of New CD Database
  68. Global Const DB_INTEGER = 3
  69. Global Const DB_DOUBLE = 7
  70. Global Const DB_DATE = 8
  71. Global Const DB_TEXT = 10
  72. Global Const DB_LANG_GENERAL = ";LANGID=0x0809;CP=1252;COUNTRY=0"
  73.  
  74. ' Profile String Information
  75. Declare Function GetPrivateProfileString Lib "Kernel" (ByVal lpAppName As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString$, ByVal nSize%, ByVal lpFileName As String) As Integer
  76. Declare Function WritePrivateProfileString Lib "Kernel" (ByVal lpAppName As String, ByVal lpKeyName As String, ByVal lpString As String, ByVal lpFileName As String) As Integer
  77.  
  78. ' For Floating Titles
  79. Declare Function WindowFromPoint Lib "User" (ByVal X As Integer, ByVal Y As Integer) As Integer
  80.  
  81. Sub AnimateIcon (CDTime As Variant)
  82.     Dim FName As String, Fsize As Integer
  83.     Dim FItalic As Integer
  84.     
  85.     ' Save and Reset Font Options
  86.     FName = CDForm.FontName
  87.     Fsize = CDForm.FontSize
  88.     FItalic = CDForm.FontItalic
  89.     CDForm.FontName = "Modern"
  90.     CDForm.FontSize = 12
  91.     CDForm.FontItalic = False
  92.  
  93.     CDForm.Cls
  94.     CDForm.Line (0, 0)-(510, 310), &H0, BF
  95.     CDForm.DrawWidth = 2
  96.     CDForm.Line (525, 75)-(530, 350)
  97.     CDForm.Line (50, 350)-(525, 350)
  98.     CDForm.DrawWidth = 1
  99.     CDForm.CurrentX = 10
  100.     CDForm.CurrentY = 10
  101.     CDForm.Print CDTime
  102.  
  103.     CDForm.FontName = FName
  104.     CDForm.FontSize = Fsize
  105.     CDForm.FontItalic = FItalic
  106.     
  107. End Sub
  108.  
  109. Function CDExists (CDIDNo As Long) As Integer
  110.     Dim Db As Database
  111.     Dim Tb As Table
  112.  
  113.     Set Db = OpenDatabase(AppPath & "\CDPlayer.MDb")
  114.     Set Tb = Db.OpenTable("Titles")
  115.     Tb.Index = "PrimaryKey"
  116.     Tb.Seek "=", CDIDNo
  117.     If Tb.NoMatch Then
  118.     CDExists = False
  119.     Else
  120.     CDExists = True
  121.     End If
  122.  
  123.  
  124. End Function
  125.  
  126. Sub CenterForm (Center As Form, ShowForm As Integer)
  127.     Load Center
  128.     Center.Top = (Screen.Height - Center.Height) / 2
  129.     Center.Left = (Screen.Width - Center.Width) / 2
  130.     If ShowForm = True Then
  131.     Center.Show
  132.     Center.Refresh
  133.     End If
  134. End Sub
  135.  
  136. Sub CenterLogo (CForm As Form, TheControl As Control)
  137.     CForm.picLogo.Left = (TheControl.Width - CForm.picLogo.Width) / 2
  138. End Sub
  139.  
  140. Sub ChangeMenuStatus (State As Integer)
  141.         CDForm.mnuOptions.Enabled = State
  142.         CDForm.mnuCDInfo.Enabled = State
  143.         CDForm.Status.Caption = "Length: -None- Time: -None-"
  144. End Sub
  145.  
  146. Sub CommitChanges ()
  147.     Dim Db As Database
  148.     Dim DS As Dynaset
  149.     Dim Titles As Dynaset, Tracks As Dynaset
  150.     Dim I As Integer
  151.     
  152.     Set Db = OpenDatabase(AppPath & "\CDPlayer.Mdb")
  153.     Set Titles = Db.CreateDynaset("Titles")
  154.     Set Tracks = Db.CreateDynaset("Tracks")
  155.  
  156.     If CDExists(CDInfo.ID) Then
  157.     Titles.FindFirst "Title_ID = " & CDInfo.ID
  158.     If Titles.NoMatch Then
  159.         MsgBox "Couldn't Find Record!", 0, "Attention!"
  160.         Exit Sub
  161.     End If
  162.     BeginTrans ' Begin a TransAction
  163.     Titles.Edit
  164.     Titles("Title_Name") = CDInfo.CDTitle
  165.     Titles("Title_Artist") = CDInfo.CDAuthor
  166.     
  167.     If CDInfo.CDTotalTime = "" Then CDInfo.CDTotalTime = GetCDLength(NumOfTracks)
  168.     If Len(CDInfo.CDTotalTime) >= 5 Then
  169.         Titles("Title_Length") = TimeValue(("12:" & CDInfo.CDTotalTime))
  170.     Else
  171.         Titles("Title_Length") = TimeValue(CDInfo.CDTotalTime)
  172.     End If
  173.  
  174.     Titles.Update
  175.     CommitTrans
  176.  
  177.     Tracks.Filter = "Title_ID = " & CDInfo.ID
  178.     Set Tracks = Tracks.CreateDynaset()
  179.     BeginTrans
  180.  
  181.     For I = 1 To NumOfTracks
  182.         Tracks.FindFirst "Track_No = " & I
  183.         Tracks.Edit
  184.         Tracks("Track_Title") = Left$(Mid$(CDTrackNo(I), 5, (Len(CDTrackNo(I)) - 5)), 30)
  185.         Tracks("Track_Length") = TimeValue(CDTime(I))
  186.         Tracks.Update
  187.     Next
  188.     CommitTrans
  189.     
  190.     Else
  191.     BeginTrans
  192.     Titles.AddNew
  193.     Titles("Title_ID") = CDInfo.ID
  194.     Titles("Title_Name") = CDInfo.CDTitle
  195.     Titles("Title_Artist") = CDInfo.CDAuthor
  196.  
  197.     If CDInfo.CDTotalTime = "" Then CDInfo.CDTotalTime = GetCDLength(NumOfTracks)
  198.     If Len(CDInfo.CDTotalTime) >= 5 Then
  199.         Titles("Title_Length") = TimeValue(("12:" & CDInfo.CDTotalTime))
  200.     Else
  201.         Titles("Title_Length") = TimeValue(CDInfo.CDTotalTime)
  202.     End If
  203.     
  204.     Titles.Update
  205.  
  206.     For I = 1 To NumOfTracks
  207.         Tracks.AddNew
  208.         Tracks("Title_ID") = CDInfo.ID
  209.         Tracks("Track_No") = I
  210.         Tracks("Track_Title") = Left$(Mid$(CDTrackNo(I), 5, (Len(CDTrackNo(I)) - 5)), 30)
  211.         Tracks("Track_Length") = TimeValue(CDTime(I))
  212.         Tracks.Update
  213.     Next
  214.     CommitTrans
  215.     End If
  216. End Sub
  217.  
  218. Sub CreateCDDatabase ()
  219.     On Error GoTo DB_Problems:
  220.     Dim CDPlayer As Database
  221.     
  222.     ' Titles Table
  223.     Dim NewTitles As New TableDef
  224.     Dim NewTitlesIdx As New Index
  225.     Dim TitlesTitle_ID As New Field
  226.     Dim Title_Name As New Field
  227.     Dim Title_Artist As New Field
  228.     Dim Title_Length As New Field
  229.  
  230.     ' Tracks Table
  231.     Dim NewTracks As New TableDef
  232.     Dim NewTracksIdx As New Index
  233.     Dim TracksTitle_ID As New Field
  234.     Dim Track_No As New Field
  235.     Dim Track_Title As New Field
  236.     Dim Track_Length As New Field
  237.       
  238.     CDForm.frmDisabledCD.Caption = "Creating New CD Database . . ."
  239.     Set CDPlayer = CreateDatabase(AppPath & "\CDPlayer.mdb", DB_LANG_GENERAL)
  240.     
  241.     ' Create Titles Table and Fields
  242.     NewTitles.Name = "Titles"
  243.     TitlesTitle_ID.Name = "Title_ID"
  244.     TitlesTitle_ID.Type = DB_DOUBLE
  245.     Title_Name.Name = "Title_Name"
  246.     Title_Name.Type = DB_TEXT
  247.     Title_Name.Size = 30
  248.     Title_Artist.Name = "Title_Artist"
  249.     Title_Artist.Type = DB_TEXT
  250.     Title_Artist.Size = 30
  251.     Title_Length.Name = "Title_Length"
  252.     Title_Length.Type = DB_DATE
  253.  
  254.     ' Create Tracks Table and Fields
  255.     NewTracks.Name = "Tracks"
  256.     TracksTitle_ID.Name = "Title_ID"
  257.     TracksTitle_ID.Type = DB_DOUBLE
  258.     Track_No.Name = "Track_No"
  259.     Track_No.Type = DB_INTEGER
  260.     Track_Title.Name = "Track_Title"
  261.     Track_Title.Type = DB_TEXT
  262.     Track_Title.Size = 30
  263.     Track_Length.Name = "Track_Length"
  264.     Track_Length.Type = DB_DATE
  265.  
  266.       
  267.     ' Create Indexes
  268.     NewTitlesIdx.Name = "PrimaryKey"
  269.     NewTitlesIdx.Fields = "Title_ID"
  270.     NewTitlesIdx.Primary = True
  271.     NewTitlesIdx.Unique = True
  272.     NewTracksIdx.Name = "PrimaryKey"